home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Language/OS - Multiplatform Resource Library
/
LANGUAGE OS.iso
/
smaltalk
/
st80_pr4.lha
/
st80_pre4
/
Foible
/
foible
/
PopUpNotifier.st
< prev
Wrap
Text File
|
1993-07-24
|
2KB
|
100 lines
'From Tektronix Smalltalk-80 version T2.2.0cM3, of September 21, 1987 on 25 July 1988 at 5:13:44 pm'!
PopUpMenu subclass: #PopUpNotifier
instanceVariableNames: ''
classVariableNames: 'Boundary Heading '
poolDictionaries: ''
category: 'Accessories'!
!PopUpNotifier methodsFor: 'controlling'!
startUp: aSymbol
"Display and make a selection from the receiver as long as the button
denoted by the symbol, aSymbol, is pressed. Answer the current selection."
| done |
done _ false.
self displayAt: Sensor cursorPoint
during: [Sensor cursorPoint: marker center.
Sensor waitNoButton.
[done] whileFalse: [
(self buttonPressed: aSymbol)
ifFalse: [(frame containsPoint: Sensor cursorPoint)
ifFalse: [Display flash: frame.
self markerOff]
ifTrue: [(selection = 0)
ifTrue:[self markerOn: self topLeft]]]
ifTrue: [(frame containsPoint: Sensor cursorPoint)
ifTrue: [done _ (frame containsPoint:
Sensor waitNoButton)]]
]
].
^selection! !
!PopUpNotifier methodsFor: 'private'!
fixString: aString
"Return a string that is wrapped before it exceeds the width of Heading"
| begin cr string width size end length |
cr _ '
'.
begin _ 1.
string _ Heading, cr, cr, Boundary.
length _ 0.
end _ begin.
width _ (Heading size) - ( 2 * (Boundary size)).
size _ aString size.
[end > size] whileFalse: [
end _ aString findString: ' ' startingAt: end.
((end = 0) | (end = size) | ((end - begin) >= width))
ifTrue: [(end = 0) ifTrue: [end _ size].
string _ string, (aString copyFrom: begin to: end),
Boundary, cr, Boundary.
begin _ end + 1.
].
end _ end + 1.
].
^string!
labels: aString textStyle: aTextStyle lines: anArray
| para |
labelString _ self fixString: aString.
textStyle _ aTextStyle alignment: 0.
^super labels: labelString textStyle: textStyle lines: #(1)! !
"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
PopUpNotifier class
instanceVariableNames: ''!
!PopUpNotifier class methodsFor: 'class initialization'!
initialize
"Create the default heading"
"PopUpNotifier initialize"
Boundary _ ' '.
Heading _ Boundary,'Click middle button when done',Boundary.! !
!PopUpNotifier class methodsFor: 'instance creation'!
message: aString
"Create a PopUpMenu with standard heading, and start it up"
^(PopUpNotifier labels: aString) startUp: #yellowButton! !
PopUpNotifier initialize!